home *** CD-ROM | disk | FTP | other *** search
/ Mac100% 1998 November / MAC100-1998-11.ISO.7z / MAC100-1998-11.ISO / ｵﾝﾗｲﾝｿﾌﾄ定点観測 / ﾕｰﾃｨﾘﾃｨ / Mops 3.2.sea / Mops 3.2 / Mops source / More classes / Bitstring next >
Text File  |  1997-01-02  |  4KB  |  229 lines
  1. ¥ BITSTRING class.  May 88.
  2.  
  3. need    bytestring
  4.  
  5.  
  6. :code BLOCATE    ¥ ( n b -- bit-index OR -1 )
  7.  
  8. ¥ Bit locate.  bit-index points to the 1st occurrence of bit b in n,
  9. ¥ proceeding from left to right.  The leftmost bit has index zero
  10. ¥ (sensibly, unlike the usual 68000 convention).  If the bit is not
  11. ¥ found we return -1.
  12. ¥ This code was lifted from the earlier PDP-11 version.  DEC numbers
  13. ¥ bits the wrong way round, too.  So does Intel.  But IBM's OK, and
  14. ¥ the PowerPC is eminently sensible.
  15. ¥ (Alright, alright, so we're strictly big-endian around here.)
  16.  
  17.     loc
  18.     MOVEQ    #-1,D0        ; Initial result
  19.     TST    (SP)+
  20.     BNE.S    getn
  21.     NOT    (SP)
  22. getn    MOVE    (SP),D1
  23.     BEQ.S    end
  24. lp    ADDQ    #1,D0
  25.     ROL    #1,D1
  26.     BCC.S    lp
  27. end    MOVE    D0,(SP)
  28. ;code
  29.  
  30.  
  31. :class BITSTRING    super( bytestring )
  32.  
  33.     int    BP
  34.     int    BL
  35.  
  36. :mcode BPOS:
  37.     MOVE    8(A2),D0
  38.     LSL    #3,D0
  39.     OR.W    18(A2),D0
  40.     PUSH    D0
  41. ;mcode
  42.  
  43. :mcode BLIM:
  44.     MOVE    12(A2),D0
  45.     LSL    #3,D0
  46.     OR.W    20(A2),D0
  47.     PUSH    D0
  48. ;mcode
  49.  
  50. :mcode >BPOS:
  51.     POP    D0
  52.     MOVE    D0,D1
  53.     ANDI    #7,D1
  54.     MOVE.W    D1,18(A2)
  55.     LSR    #3,D0
  56.     MOVE    D0,8(A2)
  57. ;mcode
  58.  
  59. :mcode >BLIM:
  60.     POP    D0
  61.     MOVE    D0,D1
  62.     ANDI    #7,D1
  63.     MOVE.W    D1,20(A2)
  64.     LSR    #3,D0
  65.     MOVE    D0,12(A2)
  66. ;mcode
  67.  
  68. :mcode BLEN:
  69.     MOVE    8(A2),D0
  70.     LSL    #3,D0
  71.     OR.W    18(A2),D0
  72.     MOVE    12(A2),D1
  73.     LSL    #3,D1
  74.     OR.W    20(A2),D1
  75.     SUB    D0,D1
  76.     PUSH    D1
  77. ;mcode
  78.  
  79. :mcode >BLEN:
  80.     MOVE    8(A2),D0
  81.     LSL    #3,D0
  82.     OR.W    18(A2),D0
  83.     ADD    (SP)+,D0
  84.     MOVE    D0,D1
  85.     ANDI    #7,D1
  86.     MOVE.W    D1,20(A2)
  87.     LSR    #3,D0
  88.     MOVE    D0,12(A2)
  89. ;mcode
  90.  
  91. :m BSKIP:    bpos: self  +  >bpos: self  ;m
  92.  
  93. :m START:    clear: pos  clear: bp     ;m
  94. :m NOLIM:    nolim: super  clear: bl   ;m
  95. :m RESET:    start: self  nolim: self  ;m
  96.  
  97. :m BSTEP:    get: lim  get: bl  put: bp  put: pos  nolim: self  ;m
  98. :m <BSTEP:    get: pos  get: bp  put: bl  put: lim   clear: pos  ;m
  99.  
  100.  
  101. :m ROUNDBPOS:    ¥ Rounds BPOS up to a byte boundary.
  102.     get: bp  0<>  -: pos  clear: bp  ;m
  103.  
  104. :m ROUNDBLIM:
  105.     get: bl  0<>  -: lim  clear: bl  ;m
  106.  
  107. :mcode (>NXTNB):
  108.     loc
  109. ¥    call    debugger
  110.     MOVEM.L    D3/D4/D7,-(A7)
  111.     POP    D1        ; D1 = #bits
  112.     POP    D0        ; D0 = n
  113.     MOVEQ    #32,D2
  114.     SUB    D1,D2        ; D2 = left shift quantity
  115.     MOVE.W    18(A2),D3    ; D3 = bp
  116.     LSL    D2,D0
  117.     LSR    D3,D0        ; align n in D0
  118.     MOVEQ    #-1,D1
  119.     LSL    D2,D1
  120.     LSR    D3,D1        ; D1 = aligned mask
  121.     MOVE    (A2),A0        ; A0 = handle
  122.     MOVE    (A0),A0        ; Dereference it - addr of start of string
  123.     ADD    8(A2),A0    ; Add POS, giving addr of start of active part
  124.     MOVEQ    #3,D7
  125. lp1    LSL    #8,D4
  126.     MOVE.B    (A0)+,D4
  127.     DBRA    D7,lp1
  128.     NOT    D1
  129.     AND    D1,D4
  130.     OR    D0,D4
  131.     MOVEQ    #3,D7
  132. lp2    move.b    D4,-(A0)
  133.     LSR    #8,D4
  134.     DBRA    D7,lp2
  135.     MOVEM.L    (A7)+,D3/D4/D7
  136. ;mcode
  137.  
  138. :m >NXTNB:  { n #bits -- }
  139.     ¥ Overwrites #bits bits of SELF with n, which is right justified.  
  140.     ¥ Updates BPOS.  #bits must be less than 25.
  141.  
  142.     n #bits  (>nxtnb): self
  143.     #bits  bskip: self  ;m
  144.  
  145.  
  146. :mcode BFIND:        ¥ ( flg -- n b )
  147.         ¥ Updates BPOS.  n is #bits scanned.
  148.     loc
  149. ¥    call    debugger
  150.     MOVEM.L    D3/D4/D7,-(A7)
  151.     MOVE    (SP),D1        ; D1 = boolean we're looking for
  152.     SEQ    D1        ; Set to inverse for search on not equal
  153.     CLR    -(SP)        ; For return result
  154.     BSR    dic[getit]
  155.     BLE.S    failed
  156.     MOVE.B    (A0),D7        ; Save 1st char in D7
  157.     MOVE    A0,A1        ; and its addr in A1
  158.     MOVE.W    18(A2),D3
  159.     MOVE.W    #$00FF,D4
  160.     LSR.W    D3,D4
  161.     AND.B    D4,(A0)
  162.     NOT.B    D4
  163.     AND.B    D1,D4
  164.     OR.B    D4,(A0)
  165.     MOVEQ    #0,D4        ; Set "equal"
  166.     BRA.S    lptst
  167.  
  168. lp    CMP.B    (A0)+,D1
  169. lptst    DBNE    D0,lp
  170.     DBNE    D2,lp
  171.     BEQ.S    failed
  172.     SUBQ    #1,(SP)        ; We found it
  173.     SUBQ    #1,A0
  174.     MOVE.B    (A0),D0
  175.     EOR.B    D1,D0
  176.     MOVEQ    #-1,D4
  177. lp2    ADDQ    #1,D4
  178.     ROL.B    #1,D0
  179.     BCC.S    lp2
  180.     BRA.S    rslts
  181.  
  182. failed    MOVE    12(A2),A0
  183.     ADD    dic[$start],A0
  184.     MOVE.W    20(A2),D4
  185.  
  186. rslts    MOVE    8(A2),D0
  187.     LSL    #3,D0
  188.     OR.W    18(A2),D0    ; Old BPOS to D0
  189.     MOVE    A0,D1
  190.     SUB    dic[$start],D1
  191.     MOVE    D1,8(A2)    ; Set POS to found posn
  192.     LSL    #3,D1
  193.     OR.W    D4,D1        ; New BPOS to D1
  194.     MOVE.W    D4,18(A2)
  195.     SUB    D0,D1
  196.     MOVE    D1,4(SP)
  197. end    MOVE.B    D7,(A1)        ; Restore first char
  198.     MOVEM.L    (A7)+,D3/D4/D7
  199. ;mcode
  200.  
  201.  
  202. ¥ :m BSEARCH:  { flg ¥ sav1st savpos -- b }
  203. ¥    1st: self  -> sav1st  get: pos  -> savpos
  204. ¥    $ FF00  get: bp  >>  ^1st: self
  205. ¥    flg IF  creset  0  ELSE  cset  -1  THEN
  206. ¥    chskip?: self  dup
  207. ¥    IF  ( found )
  208. ¥        1st: self  24 <<  flg  blocate  put: bl
  209. ¥        get: pos  put: lim
  210. ¥        savpos  put: pos
  211. ¥    THEN    
  212. ¥    sav1st  ptr: self  savpos +  c!  ;m    ¥ Restore 1st char
  213.  
  214. :m DUMP:
  215.     ." bpos:"  bpos: self  .h  ."  blim:"  blim: self  .h  cr
  216.     dump: super  ;m
  217.  
  218. ;class
  219.  
  220. endload
  221.  
  222. bitstring  BB
  223.  
  224. : GO
  225.     new: bb  " hello"  put: bb
  226.     get: bb erase  3 skip: bb 4 >nxtc: bb reset: bb  ;
  227.  
  228. : zz  release: bb  ;
  229.